unit cc_dict;

interface

uses  SysUtils, Classes, Controls, Forms, Buttons, StdCtrls, dialogs, checklst, extctrls, mu_parser, filectrl;

type

 CDictIteratorEvent = procedure(Sender : TObject; var field, value : String) of object;

 dbFV = record
  field : string;
  value : string;
 end;

 pdbFV = ^dbFV;

type

 CCDict = Class
  private
   index : longint;
   FOnNext : CDictIteratorEvent;
   data : TList;
   changed: boolean;
  public
   constructor Create;
   destructor Destroy; override;
   procedure addValue(field, value : string);
   function getCellByField(field : string) : longint;
   function getValue(field : string) : string;
   procedure print(str : TStrings);
   procedure saveToFile(fileName : String);
   procedure loadFromFile(fileName : String);
   property OnNext: CDictIteratorEvent read FOnNext write FOnNext;
   procedure run(callback : CDictIteratorEvent);
 end;

 dbDict = record
  id : longint;
  data : CCDict;
 end;

 pdbDict = ^dbDict;

 CCDictList = class
  private
   index: array[1..5000] of longint;
   flastid: longint;
   function getCount : longint;
  public
   data : TList;
   constructor Create;
   destructor Destroy; override;
   function addItem(ini : CCDict) : boolean;
   function getItemById(id: longint) : CCDict;
   procedure refreshIndexes;
   procedure delete(id: longint);
   procedure saveToDir(dirname: String);
   procedure loadFromDir(dirname: String);
   property count : longint read getCount;
   property lastid : longint read Flastid;
  end;


function getTemplateForm(formName: string; params: CCDict):CCDict;
procedure saveControlToDict(control: TObject; var dict: CCDict);
procedure fillFormFromDict(form: TForm; dict: CCDict);

implementation

uses struct;

procedure CCDictList.delete;
var
 ind: Longint;
begin
 ind := index[id];
 if ind = -1 then exit;
 index[id] := -1;
 data.Delete(ind);
 refreshindexes;
 data.pack;
end;

procedure CCDictList.loadFromDir;
var
 i:integer;
 searchRec: TSearchRec;
 res: Integer;
 dict: CCDict;
begin
 if global_debug then showmessage('671');
 try
  if (data<>nil) and (data.count>0) then for i:=0 to data.count-1 do CCDict(data.items[i]).free;
 except
  showmessage('MEmory Error');
 end;
 data.clear;
 flastid := 0;
 fillchar(index, sizeof(index), -1);
 if not directoryexists(dirname) then exit;
 res := FindFirst(dirname + '*.dct', faanyfile, SearchRec);
 if global_debug then showmessage('672_5');
 repeat
  if res = 0 then begin
   if global_debug then showmessage('672_6');
   dict := CCDict.create;
   if global_debug then showmessage('672_7');
   if global_debug then showmessage('673_1');
   dict.loadFromFile(dirname+searchrec.name);
   if global_debug then showmessage('673_2');
   addItem(dict);
   if res = 0  then res := FindNext(SearchRec);
  end;
  if global_debug then showmessage('672_8');
 until res<>0;
 if global_debug then showmessage('674');
 FindClose(SearchRec);
 if global_debug then showmessage('675');
end;

procedure CCDictList.saveToDir;
var
 i:integer;
begin
 if not directoryexists(dirname) then exit;
 for i:=0 to data.Count-1 do begin
  CCDict(data.Items[i]).savetofile(dirname+CCDict(data.Items[i]).getValue('id')+'.dct');
 end; 
end;

procedure fillFormFromDict;
var
 a: TComponent;
 i, j: integer;
 cbnum, value, field: string;
 cb: TCheckListBox;
begin
 for i:=0 to form.ComponentCount-1 do begin
  field := form.components[i].name;
  value := trim(dict.getValue(field));
//  if value = '' then continue;
  a := form.components[i];
  if a is TEDit then (a as TEdit).text := value else
  if a is TRadioGroup then begin
   if value <> '' then begin
    try
     (a as TRadioGroup).itemindex := strtoint(value);
    except
    end;
   end else (a as TRadioGroup).itemindex := -1;
  end;
  if a is TCheckListBox then begin
   cb := a as TCheckListBox;
   for j:=0 to cb.items.count-1 do cb.checked[j] := false;
   for j:=1 to cb.items.count do begin
    cbnum := getToken(value,j,',');
    if cbnum = '' then break;
    try
     cb.Checked[strtoint(cbnum)] := true;
    except
     break;
    end;
   end;
  end;
 end;
end;


procedure saveControlToDict;
var
  value,field: String;
  cb: TCheckListBox;
  i:integer;
begin
 if not (control is TComponent) then exit;
 if dict = nil then exit;
 value := '';
 field := (control as TComponent).name;
 if control is TEdit then begin
  value := (control as TEdit).text;
 end else
 if (control is TCheckListBox) then begin
  cb := (control as TCheckListBox);
  for i := 0 to cb.Items.count - 1 do if cb.Checked[i] then value := value + inttostr(i) + ',';
 end else
 if (control is TRadioGroup) then begin
  value := inttostr((control as TRAdioGroup).itemindex);
 end;
 dict.addValue(field, value);
end;

function getTemplateForm;
var
 form: TForm;
 i: integer;
 flag: boolean;
 a: TComponent;
 res: CCDict;
 value: string;
begin
 result := nil; flag := false; form := nil;
 for i:=0 to screen.FormCount-1 do begin
  form := screen.forms[i];
  if form.Name = formName then begin
   flag := true;
   break;
  end;
 end;
 if not flag then exit;
 for i:=0 to form.ComponentCount-1 do begin
  a := form.Components[i];
  if params <> nil then value := params.getValue(a.name) else value := '';
  if a is TEdit then (a as TEdit).text := value;
 end;
 if form.ShowModal = mrCancel then exit;
 res := CCDict.create;
 if params <> nil then res.addValue('id',params.getValue('id'));
 for i:=0 to form.ComponentCount-1 do begin
  a := form.Components[i];
  if a is TEdit then res.addValue((a as TEdit).name, (a as TEdit).text);
 end;
 result := res;
end;

procedure CCDict.run;
var
 i:integer;
begin
 OnNext := callback;
 for i:=0 to data.count-1 do OnNext(self, pdbFv(data.Items[i])^.field, pdbFv(data.Items[i])^.value);
 OnNext := nil;
end;

procedure CCDict.loadFromFile;
var
 fd : TStrings;
 left,right : string;
 p,i : integer;
begin
 changed:= false;
 if (data<>nil) and (data.count>0) then for i:=0 to data.count-1 do dispose(data.items[i]);
 data.free;
 data := TList.create;
 if not fileexists(fileName) then exit;
 fd := TStringList.Create;
 fd.loadfromfile(fileName);
 for i:=0 to fd.count-1 do begin
  p := pos('=', fd[i]);
  if p = 0 then continue;
  left := trim(copy(fd[i], 1, p-1));
  right := trim(copy(fd[i], p+1, length(fd[i])-p));
  if (left <> '') then addValue(left, right);
 end;
 fd.free;
end;

procedure CCDict.saveToFile;
var
 fd : TStrings;
begin;
 if not changed then exit;
 fd := TStringList.Create;
 print(fd);
 fd.savetofile(fileName);
 fd.free;
 changed := false;
end;

procedure CCDict.print;
var
 i:integer;
begin
 for i:=0 to data.count-1 do begin
  str.Add(pdbFv(data.Items[i])^.field+' = '+pdbFv(data.Items[i])^.value);
 end;
end;

function CCDict.getValue;
begin
 index := getCellByField(field);
 if index = -1 then result := ''
    else result := pdbFv(data.Items[index])^.value
end;

function CCDict.getCellByField;
var
 i:longint;
begin
 result := -1;
 for i:=0 to data.count-1 do if pdbFv(data.Items[i])^.field = field then begin
  result := i;
  break;
 end;
end;

procedure CCDict.addValue;
var
 item : pdbFV;
begin
 index := getCellByField(field);
 if index = -1 then begin
  new(item);
  item^.field := field;
  item^.value := value;
  data.Add(item);
 end else begin
  pdbFv(data.Items[index])^.value := value;
 end;
 changed := true;
end;

constructor CCDict.Create;
begin
 inherited Create;
 data := TList.Create;
end;

destructor CCDict.Destroy;
var
 i:integer;
begin
 inherited Destroy;
 if (data=nil) or (data.count=0) then exit;
 try
  for i:=0 to data.count-1 do dispose(data.items[i]);
 except
 end;
 data.clear;
 data.free;
end;

function CCDictList.getItemById;
var
 ind : longint;
begin
 result := nil;
 ind := index[id];
 if ind = -1 then exit;
 result := CCDict(data.items[ind]);
end;

procedure CCDictList.refreshIndexes;
var
 i:integer;
 ids:string;
 id: longint;
begin
 flastid := 0;
 for i:=0 to data.count-1 do begin
  ids := CCDict(data.items[i]).getValue('id');
  try
   id := strtoint(ids);
  except
   on EConvertError do id := -1;
  end;
  if id<>-1 then begin
   index[id] := i;
   if id>lastid then flastid := id;
  end;
 end;
end;

function CCDictList.getCount;
begin
 result := data.count;
end;

function CCDictList.addItem;
var
 id, ind: longint;
 ids: string;
begin;
 result := false;
 if ini = nil then exit;
 ids := ini.getValue('id');
 if ids = '' then begin
  flastid := flastid + 1;
  id := flastid;
 end else begin
  try
   id := strtoint(ids);
  except
   on EConvertError do begin
     flastid := flastid + 1;
     id := flastid;
   end;
  end;
 end;
 ids := inttostr(id);
 if id>lastid then flastid:=id;
 ini.addValue('id', ids);
 if index[id] <> -1 then  begin
  data.Delete(index[id]);
 end;
 ind := data.add(ini);
 index[lastid] := ind;
 data.Pack;
 refreshIndexes;
 result := true;
end;

constructor CCDictList.Create;
begin
 inherited Create;
 flastid := 0;
 data := TList.create;
 fillchar(index,sizeof(index),-1);
end;

destructor CCDictList.Destroy;
var
 i:integer;
begin;
 inherited Destroy;
 if (data=nil) or (data.count=0) then exit;
 try
  for i:=0 to data.count-1 do CCDict(data.items[i]).free;
 except
 end;
 data.clear;
 data.free;
end;

end.
